home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_pr4.lha / st80_pre4 / Foible / foible / BinIO-TEKfix.st next >
Text File  |  1993-07-24  |  5KB  |  157 lines
  1. 'From Tektronix Smalltalk-80 version T2.2.0cM3, of September 21, 1987 on 28 November 1989 at 5:47:51 pm'!
  2.  
  3.  
  4.  
  5. !Object methodsFor: 'comparing'!
  6.  
  7. identityHash
  8.     "Answer a SmallInteger whose value is half of the receiver's object pointer
  9.     (interpreting object pointers as 16-bit signed quantities).  
  10.     Can be used if the hash method is overridden.  Fails if the 
  11.     receiver is a SmallInteger.  Essential.  See documentation in Object metaclass."
  12.  
  13.     <primitive: 75>
  14.     self primitiveFailed! !
  15.  
  16. !Object methodsFor: 'public binary storage'!
  17.  
  18. storeBinary
  19.     "Writes a description of the receiver into a file, in a way that allows
  20.      the object's structure to be reconstructed from the file's contents."
  21.  
  22.     | fileName |
  23.     fileName _ (FileDirectory currentDirectory)
  24.                     requestFileName: 'Store binary on which file name?'
  25.                     default: (self class name, '.', self asOop printString, '.stbin')
  26.                     version: #any
  27.                     ifFail: [^nil].
  28.     BinaryOutputManager store: self on: fileName! !
  29.  
  30.  
  31. !PopUpMenu class methodsFor: 'instance creation'!
  32.  
  33. labelList: labelArray
  34.     "Create a menu with labels from those grouped in labelArray."
  35.  
  36.     | stream lines line i k label|
  37.     stream _ WriteStream on: (String new: 50).
  38.     lines _ OrderedCollection new: labelArray size-1.
  39.     line _ 0.
  40.     labelArray
  41.         do: [:labels |
  42.             k _ 1.
  43.             [k <= labels size] whileTrue:
  44.                 [label _ labels at: k.
  45.                 i _ 1.
  46.                 [i <= label size] whileTrue:
  47.                     [stream nextPut: (label at: i).
  48.                     i _ i + 1.].
  49.                 k _ k + 1.
  50.                 stream cr].
  51.             line _ line + labels size.
  52.             lines add: line].
  53.     lines isEmpty ifFalse: [lines removeLast].
  54.     stream skip: -1.  "remove the final cr"
  55.     ^self 
  56.         labels: stream contents
  57.         lines: lines! !
  58.  
  59. !FileDirectory class reorganize!
  60. ('instance creation' currentDirectory directory:directoryName: directoryFromName:setFileName: directoryNamed: fileNamed:)
  61. !
  62.  
  63.  
  64.  
  65. !TextStyle class methodsFor: 'binary storage'!
  66.  
  67. addGlobalsTo: globalDictionary manager: manager
  68.     StyleManager do: [:style|
  69.         style fontArray do: [:font|
  70.             globalDictionary at: font put: self]]!
  71.  
  72. storeBinaryDefinitionOf: anObject on: stream manager: manager
  73.     | style string |
  74.     anObject class == StrikeFont ifTrue: [
  75.         StyleManager associationsDo: [:assoc|
  76.             style _ assoc value.
  77.             1 to: style fontArray size do: [:i|
  78.                 (style fontAt: i) == anObject ifTrue: [
  79.                     string _ '(TextStyle styleNamed: ', assoc key storeString, ') fontAt: ', i printString.
  80.                     stream nextNumber: 2 put: string size.
  81.                     string do: [:char| stream nextPut: char asciiValue].
  82.                     ^self]]]].
  83.     ^super storeBinaryDefinitionOf: anObject on: stream manager: manager! !
  84.  
  85.  
  86. !String methodsFor: 'converting'!
  87.  
  88. asByteArray
  89.     "Convert the receiver to a ByteArray."
  90.  
  91.     ^(ByteArray new: self size) replaceFrom: 1
  92.                 to: self size
  93.                 withString: self
  94.                 startingAt: 1! !
  95.  
  96. !FileDirectory reorganize!
  97. ('accessing' completePathname contents directoryName fullName versionNumbers)
  98. ('testing' includesKey: isEmpty statusOf:)
  99. ('adding' addKey:)
  100. ('removing' removeKey:)
  101. ('enumerating' do: filesMatching: namesDo:)
  102. ('file accessing' checkName:fixErrors: directoryNamed: file: fileClass isLegalFileName: isLegalOldFileName: newDirectory: newFile: oldFile: oldWriteOnlyFile: rename:newName:)
  103. ('file copying' append:to: copy:to:)
  104. ('alto file compatability' findKey:)
  105. ('private' beginWriting directoryFromName:setFileName: initFileName:)
  106. ('utilities' requestFileName:default:version:ifFail:)
  107. !
  108.  
  109.  
  110.  
  111. !FileDirectory methodsFor: 'utilities'!
  112.  
  113. requestFileName: message default: default version: versionType ifFail: failBlock
  114.     "Prompt for a file name.  Insist on an existing file if versionType = #old.  Evaluate failBlock if none obtained.  Note: Only works on receiving directory. New pattern doesn't allow changing directory" 
  115.  
  116.     "(FileDirectory directoryNamed: '' ) requestFileName: 'file:' default: '*.st' version: #any ifFail: []"
  117.  
  118.     | fileName list menu index err list2|
  119.     fileName _ default.
  120.     [true] whileTrue: 
  121.         [fileName _ FillInTheBlank request: message initialAnswer: fileName.
  122.         fileName isEmpty
  123.             ifTrue: [^failBlock value].
  124.         ((fileName includes: $*) or: [fileName includes: $#])
  125.             ifTrue:
  126.                 [list _ self filesMatching: fileName.
  127.                 list2 _ list collect:
  128.                     [:fname |
  129.                     (fname findString: self fullName startingAt: 1) = 1
  130.                         ifTrue: [fname copyFrom: self fullName size + 1 to: fname size]
  131.                         ifFalse: [fname]]    .
  132.                 menu _ PopUpMenu
  133.                             labelList: (Array
  134.                                             with: list2
  135.                                             with: #('new pattern' 'abort')).
  136.                 index _ menu startUp: #anyButton withHeading:
  137.                     (list isEmpty
  138.                         ifTrue: [' No Matches ']
  139.                         ifFalse: ['Choose a file from ', self fullName, fileName]) asText.
  140.                 (index == 0 or: [index = (list size + 2)])
  141.                     ifTrue: [^failBlock value].
  142.                 index <= list size ifTrue: [^list at: index]]
  143.               ifFalse:
  144.                 [ (self includesKey: fileName) ifTrue: [^fileName].
  145.                 versionType ~= #old 
  146.                     ifTrue: [(self isLegalFileName: fileName)
  147.                         ifTrue: [^fileName]
  148.                         ifFalse: [err _ ' Illegal file name: \  ']]
  149.                     ifFalse: [(self isLegalOldFileName: fileName)
  150.                         ifTrue: [^fileName]
  151.                         ifFalse: [err _ ' File illegal or not found \  ']].
  152.                 menu _ PopUpMenu labels: 'try again\abort' withCRs.
  153.                 (menu
  154.                     startUp: #anyButton
  155.                     withHeading: err withCRs , fileName , ' ') = 2
  156.                         ifTrue: [^failBlock value]]]! !
  157.